{2:}{$D-,W+}PROGRAM TFTOPL(TFMFILE,PLFILE);LABEL{3:}9999;{:3}CONST{4:}
TFMSIZE=20000;{:4}TYPE{18:}BYTE=0..255;INDEX=0..TFMSIZE;{:18}VAR{6:}
TFMFILE:PACKED FILE OF 0..255;{:6}{8:}
LF,LH,BC,EC,NW,NH,ND,NI,NL,NK,NE,NP:0..32767;{:8}{16:}PLFILE:TEXT;{:16}
{19:}TFM:ARRAY[-1000..TFMSIZE]OF BYTE;{:19}{22:}
CHARBASE,WIDTHBASE,HEIGHTBASE,DEPTHBASE,ITALICBASE,LIGKERNBASE,KERNBASE,
EXTENBASE,PARAMBASE:INTEGER;{:22}{25:}FONTTYPE:0..2;{:25}{27:}
ASCII04,ASCII10,ASCII14:PACKED ARRAY[1..32]OF CHAR;
MBLSTRING,RISTRING,RCESTRING:PACKED ARRAY[1..3]OF CHAR;{:27}{29:}
DIG:ARRAY[0..11]OF 0..9;{:29}{32:}LEVEL:0..5;{:32}{45:}CHARSONLINE:0..8;
PERFECT:BOOLEAN;{:45}{47:}I:0..32767;C,R:BYTE;K:INDEX;{:47}{63:}
LABELTABLE:ARRAY[0..257]OF RECORD CC:BYTE;RR:0..256;END;LABELPTR:0..256;
SORTPTR:0..256;{:63}{68:}ACTIVE:BOOLEAN;{:68}PROCEDURE INITIALIZE;
BEGIN WRITELN(TTY,'This is TFtoPL, Version 1');{7:}
RESET(TFMFILE,'','/B:8');{:7}{17:}REWRITE(PLFILE);{:17}{28:}
ASCII04:=' !"#$%&''()*+,-./0123456789:;<=>?';
ASCII10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]↑_';
ASCII14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';MBLSTRING:='MBL';
RISTRING:='RI ';RCESTRING:='RCE';{:28}{33:}LEVEL:=0;{:33}{46:}
CHARSONLINE:=0;PERFECT:=TRUE;{:46}{64:}LABELPTR:=0;LABELTABLE[0].RR:=0;
{:64}END;{:2}{30:}PROCEDURE OUTDIGS(J:INTEGER);BEGIN REPEAT J:=J-1;
WRITE(PLFILE,DIG[J]:1);UNTIL J=0;END;PROCEDURE PRINTDIGS(J:INTEGER);
BEGIN REPEAT J:=J-1;WRITE(TTY,DIG[J]:1);UNTIL J=0;END;{:30}{31:}
PROCEDURE PRINTOCTAL(C:BYTE);VAR J:0..2;BEGIN WRITE(TTY,'''');
FOR J:=0 TO 2 DO BEGIN DIG[J]:=C MOD 8;C:=C DIV 8;END;PRINTDIGS(3);END;
{:31}{34:}PROCEDURE OUTLN;VAR L:0..5;BEGIN WRITELN(PLFILE);
FOR L:=1 TO LEVEL DO WRITE(PLFILE,'   ');END;PROCEDURE LEFT;
BEGIN LEVEL:=LEVEL+1;WRITE(PLFILE,'(');END;PROCEDURE RIGHT;
BEGIN LEVEL:=LEVEL-1;WRITE(PLFILE,')');OUTLN;END;{:34}{35:}
PROCEDURE OUTBCPL(K:INDEX);VAR L:0..39;BEGIN WRITE(PLFILE,' ');
L:=TFM[K];WHILE L>0 DO BEGIN K:=K+1;L:=L-1;
CASE TFM[K]DIV 32 OF 1:WRITE(PLFILE,ASCII04[1+(TFM[K]MOD 32)]);
2:WRITE(PLFILE,ASCII10[1+(TFM[K]MOD 32)]);
3:WRITE(PLFILE,ASCII14[1+(TFM[K]MOD 32)]);END;END;END;{:35}{36:}
PROCEDURE OUTOCTAL(K,L:INDEX);VAR A:0..1023;B:0..32;J:0..11;
BEGIN WRITE(PLFILE,' O ');A:=0;B:=0;J:=0;WHILE L>0 DO{37:}BEGIN L:=L-1;
IF TFM[K+L]<>0 THEN BEGIN WHILE B>2 DO BEGIN DIG[J]:=A MOD 8;A:=A DIV 8;
B:=B-3;J:=J+1;END;CASE B OF 0:A:=TFM[K+L];1:A:=A+2*TFM[K+L];
2:A:=A+4*TFM[K+L];END;END;B:=B+8;END{:37};
WHILE(A>0)OR(J=0)DO BEGIN DIG[J]:=A MOD 8;A:=A DIV 8;J:=J+1;END;
OUTDIGS(J);END;{:36}{38:}PROCEDURE OUTCHAR(C:BYTE);
BEGIN IF FONTTYPE>0 THEN BEGIN TFM[0]:=C;
OUTOCTAL(0,1)END ELSE IF(C>=48)AND(C<=57)THEN WRITE(PLFILE,' C ',C-48:1)
ELSE IF(C>=65)AND(C<=90)THEN WRITE(PLFILE,' C ',ASCII10[C-63])ELSE IF(C
>=97)AND(C<=122)THEN WRITE(PLFILE,' C ',ASCII14[C-95])ELSE BEGIN TFM[0]
:=C;OUTOCTAL(0,1);END;END;{:38}{39:}PROCEDURE OUTFACE(K:INDEX);
VAR S:0..1;B:0..8;
BEGIN IF TFM[K]>=18 THEN OUTOCTAL(K,1)ELSE BEGIN WRITE(PLFILE,' F ');
S:=TFM[K]MOD 2;B:=TFM[K]DIV 2;WRITE(PLFILE,MBLSTRING[1+(B MOD 3)]);
WRITE(PLFILE,RISTRING[1+S]);WRITE(PLFILE,RCESTRING[1+(B DIV 3)]);END;
END;{:39}{40:}PROCEDURE OUTFIX(K:INDEX);VAR A:0..4095;F:0..1048575;
J:0..12;BEGIN WRITE(PLFILE,' R ');A:=(TFM[K]*16)+(TFM[K+1]DIV 16);
F:=((TFM[K+1]MOD 16)*256+TFM[K+2])*256+TFM[K+3];IF A>2047 THEN{43:}
BEGIN WRITE(PLFILE,'-');A:=4096-A;IF F>0 THEN BEGIN F:=1048576-F;A:=A-1;
END;END{:43};{41:}BEGIN J:=0;REPEAT DIG[J]:=A MOD 10;A:=A DIV 10;J:=J+1;
UNTIL A=0;OUTDIGS(J);END{:41};{42:}BEGIN J:=0;WRITE(PLFILE,'.');
REPEAT WRITE(PLFILE,(10*F)DIV 1048576:1);F:=(10*F)MOD 1048576;J:=J+1;
UNTIL(F=0)OR(J=7);END;{:42};END;{:40}{52:}
PROCEDURE CHECKBCPL(K,L:INDEX);VAR J:INDEX;C:BYTE;
BEGIN IF TFM[K]>=L THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ',
'String is too long; I''ve shortened it drastically.');END;TFM[K]:=1;
END;FOR J:=K+1 TO K+TFM[K]DO BEGIN C:=TFM[J];
IF(C=40)OR(C=41)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ',
'Parenthesis in string has been changed to slash.');END;TFM[J]:=47;
END ELSE IF(C<32)OR(C>126)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ',
'Nonstandard ascii code has been blotted out.');END;TFM[J]:=63;
END ELSE IF(C>=97)AND(C<=122)THEN TFM[J]:=C-32;END;END;{:52}{85:}
FUNCTION ORGANIZE:BOOLEAN;LABEL 9999,30;VAR TFMPTR:INDEX;BEGIN{20:}
READ(TFMFILE,TFM[0]);IF TFM[0]>127 THEN BEGIN WRITELN(TTY,
'The first byte of the input file exceeds 127!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;IF EOF(TFMFILE)THEN BEGIN WRITELN(TTY,
'The input file is only one byte long!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;READ(TFMFILE,TFM[1]);LF:=TFM[0]*256+TFM[1];
IF LF=0 THEN BEGIN WRITELN(TTY,
'The file claims to have length zero, but that''s impossible!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;IF 4*LF-1>TFMSIZE THEN BEGIN WRITELN(TTY,
'The file is bigger than I can handle!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;
FOR TFMPTR:=2 TO 4*LF-1 DO BEGIN IF EOF(TFMFILE)THEN BEGIN WRITELN(TTY,
'The file has fewer bytes than it claims!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;READ(TFMFILE,TFM[TFMPTR]);END;
IF NOT EOF(TFMFILE)THEN BEGIN WRITELN(TTY,
'There''s some extra junk at the end of the TFM file,');
WRITELN(TTY,'but I''ll proceed as if it weren''t there.');END{:20};{21:}
BEGIN TFMPTR:=2;BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;LH:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;BC:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;EC:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NW:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NH:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;ND:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NI:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NL:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NK:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NE:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
BEGIN IF TFM[TFMPTR]>127 THEN BEGIN WRITELN(TTY,
'One of the subfile sizes is negative!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;NP:=TFM[TFMPTR]*256+TFM[TFMPTR+1];TFMPTR:=TFMPTR+2;END;;
IF LF<>6+LH+(EC-BC+1)+NW+NH+ND+NI+NL+NK+NE+NP THEN BEGIN WRITELN(TTY,
'Subfile sizes don''t add up to the stated total!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;IF(NW=0)OR(NH=0)OR(ND=0)OR(NI=0)THEN BEGIN WRITELN(TTY,
'Incomplete subfiles for character dimensions!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;
IF(BC>EC+1)OR(EC>255)THEN BEGIN WRITELN(TTY,'The character code range ',
BC:1,'..',EC:1,'is illegal!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;IF NE>256 THEN BEGIN WRITELN(TTY,'There are ',NE:1,
' extensible recipes!');
WRITELN(TTY,'Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;;END{:21};{23:}BEGIN CHARBASE:=6+LH-BC;
WIDTHBASE:=CHARBASE+EC+1;HEIGHTBASE:=WIDTHBASE+NW;
DEPTHBASE:=HEIGHTBASE+NH;ITALICBASE:=DEPTHBASE+ND;
LIGKERNBASE:=ITALICBASE+NI;KERNBASE:=LIGKERNBASE+NL;
EXTENBASE:=KERNBASE+NK;PARAMBASE:=EXTENBASE+NE-1;END{:23};
ORGANIZE:=TRUE;GOTO 30;9999:ORGANIZE:=FALSE;30:END;{:85}{86:}
PROCEDURE DOSIMPLETHIN;VAR I:0..32767;BEGIN{48:}BEGIN FONTTYPE:=0;
IF LH>=12 THEN BEGIN{53:}BEGIN CHECKBCPL(32,40);
IF(TFM[32]=10)AND(TFM[33]=84)AND(TFM[34]=69)AND(TFM[35]=88)AND(TFM[36]=
32)AND(TFM[37]=77)AND(TFM[38]=65)AND(TFM[39]=84)AND(TFM[40]=72)THEN
BEGIN IF(TFM[41]=83)AND(TFM[42]=89)THEN FONTTYPE:=1 ELSE IF(TFM[41]=69)
AND(TFM[42]=88)THEN FONTTYPE:=2;END;END{:53};IF LH>=17 THEN BEGIN{55:}
LEFT;WRITE(PLFILE,'FAMILY');CHECKBCPL(72,20);OUTBCPL(72);RIGHT{:55};
IF LH>=18 THEN{56:}LEFT;WRITE(PLFILE,'FACE');OUTFACE(95);RIGHT;
FOR I:=18 TO LH-1 DO BEGIN LEFT;WRITE(PLFILE,'HEADER D ',I:1);
OUTOCTAL(24+4*I,4);RIGHT;END{:56};END;{54:}LEFT;
WRITE(PLFILE,'CODINGSCHEME');OUTBCPL(32);RIGHT{:54};END;{51:}LEFT;
WRITE(PLFILE,'DESIGNSIZE');IF LH<2 THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Design size ','missing','!');END;
WRITELN(TTY,'I''ve set it to 10 points.');WRITE(PLFILE,' D 10');
END ELSE IF TFM[28]>127 THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Design size ','negative','!');END;
WRITELN(TTY,'I''ve set it to 10 points.');WRITE(PLFILE,' D 10');
END ELSE IF(TFM[28]=0)AND(TFM[29]<16)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Design size ','too small','!');END;
WRITELN(TTY,'I''ve set it to 10 points.');WRITE(PLFILE,' D 10');
END ELSE OUTFIX(28);RIGHT;
WRITE(PLFILE,'(COMMENT DESIGNSIZE IS IN POINTS)');OUTLN;
WRITE(PLFILE,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
OUTLN{:51};{49:}LEFT;WRITE(PLFILE,'CHECKSUM');
IF LH=0 THEN WRITE(PLFILE,' O 0')ELSE OUTOCTAL(24,4);RIGHT{:49};{57:}
IF(LH>17)AND(TFM[92]>127)THEN BEGIN LEFT;
WRITE(PLFILE,'SEVENBITSAFEFLAG TRUE');RIGHT;END{:57};END{:48};{58:}
IF NP>0 THEN BEGIN LEFT;WRITE(PLFILE,'TEXINFO');OUTLN;
FOR I:=1 TO NP DO{60:}BEGIN LEFT;
IF I=1 THEN WRITE(PLFILE,'SLANT')ELSE BEGIN IF(TFM[4*(PARAMBASE+I)]>0)
AND(TFM[4*(PARAMBASE+I)]<255)THEN BEGIN TFM[4*(PARAMBASE+I)]:=0;
TFM[(4*(PARAMBASE+I))+1]:=0;TFM[(4*(PARAMBASE+I))+2]:=0;
TFM[(4*(PARAMBASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Parameter ',' ',I:1,' is too big;');END;
WRITELN(TTY,'I have set it to zero.');END;{61:}
IF I<=7 THEN CASE I OF 2:WRITE(PLFILE,'SPACE');
3:WRITE(PLFILE,'STRETCH');4:WRITE(PLFILE,'SHRINK');
5:WRITE(PLFILE,'XHEIGHT');6:WRITE(PLFILE,'QUAD');
7:WRITE(PLFILE,'EXTRASPACE')END ELSE IF(I<=22)AND(FONTTYPE=1)THEN CASE I
OF 8:WRITE(PLFILE,'NUM1');9:WRITE(PLFILE,'NUM2');
10:WRITE(PLFILE,'NUM3');11:WRITE(PLFILE,'DENOM1');
12:WRITE(PLFILE,'DENOM2');13:WRITE(PLFILE,'SUP1');
14:WRITE(PLFILE,'SUP2');15:WRITE(PLFILE,'SUP3');16:WRITE(PLFILE,'SUB1');
17:WRITE(PLFILE,'SUB2');18:WRITE(PLFILE,'SUPDROP');
19:WRITE(PLFILE,'SUBDROP');20:WRITE(PLFILE,'DELIM1');
21:WRITE(PLFILE,'DELIM2');
22:WRITE(PLFILE,'AXISHEIGHT')END ELSE IF(I<=13)AND(FONTTYPE=2)THEN IF I=
8 THEN WRITE(PLFILE,'DEFAULTRULETHICKNESS')ELSE WRITE(PLFILE,
'BIGOPSPACING',I-8:1)ELSE WRITE(PLFILE,'PARAMETER D ',I:1){:61};END;
OUTFIX(4*(PARAMBASE+I));RIGHT;END{:60};RIGHT;END;{59:}
IF(FONTTYPE=1)AND(NP<>22)THEN WRITELN(TTY,
'Unusual number of texinfo parameters for a MATHSY font (',NP:1,
' not 22).')ELSE IF(FONTTYPE=2)AND(NP<>13)THEN WRITELN(TTY,
'Unusual number of texinfo parameters for a MATHEX font (',NP:1,
' not 13).'){:59};{:58};{62:}
IF(TFM[4*WIDTHBASE]>0)OR(TFM[4*WIDTHBASE+1]>0)OR(TFM[4*WIDTHBASE+2]>0)OR
(TFM[4*WIDTHBASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','width[0] should be zero.');END;
IF(TFM[4*HEIGHTBASE]>0)OR(TFM[4*HEIGHTBASE+1]>0)OR(TFM[4*HEIGHTBASE+2]>0
)OR(TFM[4*HEIGHTBASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','height[0] should be zero.');END;
IF(TFM[4*DEPTHBASE]>0)OR(TFM[4*DEPTHBASE+1]>0)OR(TFM[4*DEPTHBASE+2]>0)OR
(TFM[4*DEPTHBASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','depth[0] should be zero.');END;
IF(TFM[4*ITALICBASE]>0)OR(TFM[4*ITALICBASE+1]>0)OR(TFM[4*ITALICBASE+2]>0
)OR(TFM[4*ITALICBASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','italic[0] should be zero.');END;
FOR I:=0 TO NW-1 DO IF(TFM[4*(WIDTHBASE+I)]>0)AND(TFM[4*(WIDTHBASE+I)]<
255)THEN BEGIN TFM[4*(WIDTHBASE+I)]:=0;TFM[(4*(WIDTHBASE+I))+1]:=0;
TFM[(4*(WIDTHBASE+I))+2]:=0;TFM[(4*(WIDTHBASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Width',' ',I:1,' is too big;');END;
WRITELN(TTY,'I have set it to zero.');END;
FOR I:=0 TO NH-1 DO IF(TFM[4*(HEIGHTBASE+I)]>0)AND(TFM[4*(HEIGHTBASE+I)]
<255)THEN BEGIN TFM[4*(HEIGHTBASE+I)]:=0;TFM[(4*(HEIGHTBASE+I))+1]:=0;
TFM[(4*(HEIGHTBASE+I))+2]:=0;TFM[(4*(HEIGHTBASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Height',' ',I:1,' is too big;');END;
WRITELN(TTY,'I have set it to zero.');END;
FOR I:=0 TO ND-1 DO IF(TFM[4*(DEPTHBASE+I)]>0)AND(TFM[4*(DEPTHBASE+I)]<
255)THEN BEGIN TFM[4*(DEPTHBASE+I)]:=0;TFM[(4*(DEPTHBASE+I))+1]:=0;
TFM[(4*(DEPTHBASE+I))+2]:=0;TFM[(4*(DEPTHBASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Depth',' ',I:1,' is too big;');END;
WRITELN(TTY,'I have set it to zero.');END;
FOR I:=0 TO NI-1 DO IF(TFM[4*(ITALICBASE+I)]>0)AND(TFM[4*(ITALICBASE+I)]
<255)THEN BEGIN TFM[4*(ITALICBASE+I)]:=0;TFM[(4*(ITALICBASE+I))+1]:=0;
TFM[(4*(ITALICBASE+I))+2]:=0;TFM[(4*(ITALICBASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Italic correction',' ',I:1,' is too big;')
;END;WRITELN(TTY,'I have set it to zero.');END;
IF NK>0 THEN FOR I:=0 TO NK-1 DO IF(TFM[4*(KERNBASE+I)]>0)AND(TFM[4*(
KERNBASE+I)]<255)THEN BEGIN TFM[4*(KERNBASE+I)]:=0;
TFM[(4*(KERNBASE+I))+1]:=0;TFM[(4*(KERNBASE+I))+2]:=0;
TFM[(4*(KERNBASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Kern',' ',I:1,' is too big;');END;
WRITELN(TTY,'I have set it to zero.');END;{:62}END;{:86}{87:}
PROCEDURE DOCHARACTERS;VAR C:BYTE;K:INDEX;BEGIN{76:}SORTPTR:=0;
FOR C:=BC TO EC DO IF TFM[4*(CHARBASE+C)]>0 THEN BEGIN IF CHARSONLINE=8
THEN BEGIN WRITELN(TTY,' ');CHARSONLINE:=1;
END ELSE BEGIN IF CHARSONLINE>0 THEN WRITE(TTY,' ');
CHARSONLINE:=CHARSONLINE+1;END;PRINTOCTAL(C);LEFT;
WRITE(PLFILE,'CHARACTER');OUTCHAR(C);OUTLN;{77:}BEGIN LEFT;
WRITE(PLFILE,'CHARWD');
IF TFM[4*(CHARBASE+C)]>=NW THEN BEGIN PERFECT:=FALSE;WRITELN(TTY,' ');
WRITE(TTY,'Width',' index for character ');PRINTOCTAL(C);
WRITELN(TTY,' is too large;');WRITELN(TTY,'so I reset it to zero.');
END ELSE OUTFIX(4*(WIDTHBASE+TFM[4*(CHARBASE+C)]));RIGHT;END{:77};
IF(TFM[4*(CHARBASE+C)+1]DIV 16)>0 THEN{78:}
IF(TFM[4*(CHARBASE+C)+1]DIV 16)>=NH THEN BEGIN PERFECT:=FALSE;
WRITELN(TTY,' ');WRITE(TTY,'Height',' index for character ');
PRINTOCTAL(C);WRITELN(TTY,' is too large;');
WRITELN(TTY,'so I reset it to zero.');END ELSE BEGIN LEFT;
WRITE(PLFILE,'CHARHT');
OUTFIX(4*(HEIGHTBASE+(TFM[4*(CHARBASE+C)+1]DIV 16)));RIGHT;END{:78};
IF(TFM[4*(CHARBASE+C)+1]MOD 16)>0 THEN{79:}
IF(TFM[4*(CHARBASE+C)+1]MOD 16)>=ND THEN BEGIN PERFECT:=FALSE;
WRITELN(TTY,' ');WRITE(TTY,'Depth',' index for character ');
PRINTOCTAL(C);WRITELN(TTY,' is too large;');
WRITELN(TTY,'so I reset it to zero.');END ELSE BEGIN LEFT;
WRITE(PLFILE,'CHARDP');
OUTFIX(4*(DEPTHBASE+(TFM[4*(CHARBASE+C)+1]MOD 16)));RIGHT;END{:79};
IF(TFM[4*(CHARBASE+C)+2]DIV 4)>0 THEN{80:}
IF(TFM[4*(CHARBASE+C)+2]DIV 4)>=NI THEN BEGIN PERFECT:=FALSE;
WRITELN(TTY,' ');WRITE(TTY,'Italic correction',' index for character ');
PRINTOCTAL(C);WRITELN(TTY,' is too large;');
WRITELN(TTY,'so I reset it to zero.');END ELSE BEGIN LEFT;
WRITE(PLFILE,'CHARIC');
OUTFIX(4*(ITALICBASE+(TFM[4*(CHARBASE+C)+2]DIV 4)));RIGHT;END{:80};
CASE(TFM[4*(CHARBASE+C)+2]MOD 4)OF 0:;1:{81:}BEGIN LEFT;
WRITE(PLFILE,'COMMENT');OUTLN;I:=TFM[4*(CHARBASE+C)+3];ACTIVE:=TRUE;
REPEAT{72:}BEGIN K:=4*(LIGKERNBASE+I);IF TFM[K+2]>=128 THEN{73:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHARBASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Kern step for',' nonexistent character ');
PRINTOCTAL(TFM[K+1]);WRITELN(TTY,'.');END ELSE BEGIN LEFT;
WRITE(PLFILE,'KRN');OUTCHAR(TFM[K+1]);
IF TFM[K+3]>=NK THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Kern index too large.');END;
WRITE(PLFILE,' R 0.0');END ELSE OUTFIX(4*(KERNBASE+TFM[K+3]));RIGHT;END;
END{:73}ELSE{74:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHARBASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Ligature step for',' nonexistent character '
);PRINTOCTAL(TFM[K+1]);WRITELN(TTY,'.');END;
IF((TFM[K+3]<BC)OR(TFM[K+3]>EC)OR(TFM[4*(CHARBASE+TFM[K+3])]=0))THEN
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;WRITE(TTY,'Bad TFM file: ','Ligature step produces the',
' nonexistent character ');PRINTOCTAL(TFM[K+3]);WRITELN(TTY,'.');
END ELSE BEGIN LEFT;WRITE(PLFILE,'LIG');OUTCHAR(TFM[K+1]);
OUTCHAR(TFM[K+3]);RIGHT;END;END{:74};
IF TFM[K]>=128 THEN BEGIN IF SORTPTR>0 THEN BEGIN WRITE(PLFILE,'(STOP)')
;OUTLN;IF LEVEL>1 THEN RIGHT;END;ACTIVE:=FALSE;END;END{:72};I:=I+1;
UNTIL ACTIVE=FALSE;RIGHT;END{:81};2:{82:}BEGIN R:=TFM[4*(CHARBASE+C)+3];
IF((R<BC)OR(R>EC)OR(TFM[4*(CHARBASE+R)]=0))THEN BEGIN BEGIN PERFECT:=
FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Character list link to',
' nonexistent character ');PRINTOCTAL(R);WRITELN(TTY,'.');END;
TFM[4*(CHARBASE+C)+2]:=4*(TFM[4*(CHARBASE+C)+2]DIV 4)+0;
END ELSE BEGIN WHILE(R<C)AND((TFM[4*(CHARBASE+R)+2]MOD 4)=2)DO R:=TFM[4*
(CHARBASE+R)+3];IF R=C THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Cycle in a character list!');END;
WRITE(TTY,'Character ');PRINTOCTAL(C);
WRITELN(TTY,' now ends the list.');
TFM[4*(CHARBASE+C)+2]:=4*(TFM[4*(CHARBASE+C)+2]DIV 4)+0;
END ELSE BEGIN LEFT;WRITE(PLFILE,'NEXTLARGER');
OUTCHAR(TFM[4*(CHARBASE+C)+3]);RIGHT;END;END;END{:82};3:{83:}
IF TFM[4*(CHARBASE+C)+3]>=NE THEN BEGIN BEGIN PERFECT:=FALSE;
WRITELN(TTY,' ');WRITE(TTY,'Extensible',' index for character ');
PRINTOCTAL(C);WRITELN(TTY,' is too large;');
WRITELN(TTY,'so I reset it to zero.');END;
TFM[4*(CHARBASE+C)+2]:=4*(TFM[4*(CHARBASE+C)+2]DIV 4)+0;
END ELSE BEGIN LEFT;WRITE(PLFILE,'VARCHAR');OUTLN;{84:}
FOR K:=0 TO 3 DO IF(K=3)OR(TFM[4*(EXTENBASE+TFM[4*(CHARBASE+C)+3])+K]>0)
THEN BEGIN LEFT;CASE K OF 0:WRITE(PLFILE,'TOP');1:WRITE(PLFILE,'MID');
2:WRITE(PLFILE,'BOT');3:WRITE(PLFILE,'REP')END;
IF((TFM[4*(EXTENBASE+TFM[4*(CHARBASE+C)+3])+K]<BC)OR(TFM[4*(EXTENBASE+
TFM[4*(CHARBASE+C)+3])+K]>EC)OR(TFM[4*(CHARBASE+TFM[4*(EXTENBASE+TFM[4*(
CHARBASE+C)+3])+K])]=0))THEN OUTCHAR(C)ELSE OUTCHAR(TFM[4*(EXTENBASE+TFM
[4*(CHARBASE+C)+3])+K]);RIGHT;END{:84};RIGHT;END{:83};END;RIGHT;END{:76}
;END;{:87}{88:}BEGIN INITIALIZE;IF NOT ORGANIZE THEN GOTO 9999;
DOSIMPLETHIN;{65:}{66:}
FOR C:=BC TO EC DO IF(TFM[4*(CHARBASE+C)+2]MOD 4)=1 THEN BEGIN R:=TFM[4*
(CHARBASE+C)+3];IF R>=NL THEN BEGIN BEGIN PERFECT:=FALSE;
WRITELN(TTY,' ');WRITE(TTY,'Ligature/kern',' index for character ');
PRINTOCTAL(C);WRITELN(TTY,' is too large;');
WRITELN(TTY,'so I reset it to zero.');END;
TFM[4*(CHARBASE+C)+2]:=4*(TFM[4*(CHARBASE+C)+2]DIV 4)+0;END ELSE{67:}
BEGIN SORTPTR:=LABELPTR;
WHILE LABELTABLE[SORTPTR].RR>R DO BEGIN LABELTABLE[SORTPTR+1]:=
LABELTABLE[SORTPTR];SORTPTR:=SORTPTR-1;END;LABELTABLE[SORTPTR+1].CC:=C;
LABELTABLE[SORTPTR+1].RR:=R;LABELPTR:=LABELPTR+1;END{:67};END;
LABELTABLE[LABELPTR+1].RR:=256;{:66};IF NL>0 THEN BEGIN LEFT;
WRITE(PLFILE,'LIGTABLE');OUTLN;{69:}ACTIVE:=FALSE;SORTPTR:=1;
FOR I:=0 TO NL-1 DO BEGIN{70:}
WHILE I=LABELTABLE[SORTPTR].RR DO BEGIN ACTIVE:=TRUE;LEFT;
WRITE(PLFILE,'LABEL');OUTCHAR(LABELTABLE[SORTPTR].CC);RIGHT;
SORTPTR:=SORTPTR+1;END{:70};IF NOT ACTIVE THEN{71:}BEGIN LEFT;
WRITE(PLFILE,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');OUTLN;
ACTIVE:=TRUE;END{:71};{72:}BEGIN K:=4*(LIGKERNBASE+I);
IF TFM[K+2]>=128 THEN{73:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHARBASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Kern step for',' nonexistent character ');
PRINTOCTAL(TFM[K+1]);WRITELN(TTY,'.');END ELSE BEGIN LEFT;
WRITE(PLFILE,'KRN');OUTCHAR(TFM[K+1]);
IF TFM[K+3]>=NK THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ','Kern index too large.');END;
WRITE(PLFILE,' R 0.0');END ELSE OUTFIX(4*(KERNBASE+TFM[K+3]));RIGHT;END;
END{:73}ELSE{74:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHARBASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Ligature step for',' nonexistent character '
);PRINTOCTAL(TFM[K+1]);WRITELN(TTY,'.');END;
IF((TFM[K+3]<BC)OR(TFM[K+3]>EC)OR(TFM[4*(CHARBASE+TFM[K+3])]=0))THEN
BEGIN PERFECT:=FALSE;IF CHARSONLINE>0 THEN WRITELN(TTY,' ');
CHARSONLINE:=0;WRITE(TTY,'Bad TFM file: ','Ligature step produces the',
' nonexistent character ');PRINTOCTAL(TFM[K+3]);WRITELN(TTY,'.');
END ELSE BEGIN LEFT;WRITE(PLFILE,'LIG');OUTCHAR(TFM[K+1]);
OUTCHAR(TFM[K+3]);RIGHT;END;END{:74};
IF TFM[K]>=128 THEN BEGIN IF SORTPTR>0 THEN BEGIN WRITE(PLFILE,'(STOP)')
;OUTLN;IF LEVEL>1 THEN RIGHT;END;ACTIVE:=FALSE;END;END{:72};END;
IF ACTIVE THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITELN(TTY,'Bad TFM file: ',
'No stop bit at the end of ligature/kern program.');END;
BEGIN WRITE(PLFILE,'(STOP)');OUTLN;IF LEVEL>1 THEN RIGHT;END;
TFM[4*(KERNBASE+0)-4]:=TFM[4*(KERNBASE+0)-4]+128;END{:69};RIGHT;END{:65}
;{75:}
IF NE>0 THEN FOR C:=0 TO NE-1 DO FOR R:=0 TO 3 DO BEGIN K:=4*(EXTENBASE+
C)+R;IF(TFM[K]>0)OR(R=3)THEN BEGIN IF((TFM[K]<BC)OR(TFM[K]>EC)OR(TFM[4*(
CHARBASE+TFM[K])]=0))THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARSONLINE>0 THEN WRITELN(TTY,' ');CHARSONLINE:=0;
WRITE(TTY,'Bad TFM file: ','Extensible recipe involves the',
' nonexistent character ');PRINTOCTAL(TFM[K]);WRITELN(TTY,'.');END;
IF R<3 THEN TFM[K]:=0;END;END;END{:75};DOCHARACTERS;WRITELN(TTY,'.');
IF LEVEL<>0 THEN WRITELN(TTY,'This program isn''t working!');
IF NOT PERFECT THEN WRITE(PLFILE,
'(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
9999:END.{:88}